home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 22 Graphics & Utilities / 3D.BIN (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  5.9 KB  |  226 lines
  1. 0 REM  ********************************
  2. 1 REM  *                              *
  3. 2 REM  *  VECTOR GRAPHICS PLOTTER V1  *
  4. 3 REM  *      FOR SUPER EXPANDER      *
  5. 4 REM  *     AND/OR  1520 PLOTTER     *
  6. 5 REM  *                              *
  7. 6 REM  *  ADAPTED FROM AN OLD PUBLIC  *
  8. 7 REM  *      DOMAIN PROGRAM BY       *
  9. 8 REM  *                              *
  10. 9 REM  *        ANDRE TAPANES         *
  11. 10 REM *         71521,2563           *
  12. 11 REM *                              *
  13. 12 REM ********************************
  14. 13 GOSUB4000:POKE53280,0:POKE53281,0
  15. 14 INPUT"  PLOTTER";PL$
  16. 15 IFPL$="Y"THENPL=1:GOTO17
  17. 16 PL=0
  18. 17 (null)END 1,"[147]GRAPHIC0"+CHR$(13)
  19. 18 (null)END 3,"[147]GRAPHIC2"+CHR$(13)
  20. 20 INPUT"  DISPLAY POINT VALUES";PV$
  21. 21 IFPV$="Y"THENPV=1:GOTO23
  22. 22 PV=0
  23. 23 INPUT"  SUPER EXPANDER CARTRIDGE";SE$
  24. 24 IFSE$="Y"THENSE=1:GOTO26
  25. 25 SE=0
  26. 26 IFSE=0ANDPL=0THEN:PRINT"[147]NO OUTPUT DEVICE NO NEED TO RUN PROGRAM":END
  27. 27 IF PL=1THEN:PRINT"  COLOR TO USE IN PLOTTER":GOTO29
  28. 28 GOTO31
  29. 29 IF PL=1THEN:INPUT"   0= BLACK [146] 1=BLUE 2=GREEN 3=RED[154]";PN%
  30. 30 IFPN%>3ORPN%<0THENPN%=0
  31. 31 IFPL=1THEN:OPEN1,6,1:OPEN2,6,2:OPEN4,6,4
  32. 32 GOSUB2000
  33. 40 REM
  34. 50 REM
  35. 130 REM
  36. 140 REM DATA FOR OBJECTS
  37. 150 REM FIRST NUMBER IS # OF POINTS
  38. 160 REM THEN COME THE POINTS (X,Y,Z)
  39. 170 REM OBJECT DATA ENDS WITH -1
  40. 180 REM
  41. 190 DATA 5,-100,200,100,100,200,100
  42. 200 DATA 100,0,100,-100,0,100,-100,200,100,0
  43. 210 DATA 5,-100,200,300,100,200,300
  44. 220 DATA 100,0,300,-100,0,300,-100,200,300,0
  45. 230 DATA2,-100,200,100,-100,200,300,0
  46. 240 DATA2,100,200,100,100,200,300,0
  47. 250 DATA2,100,0,100,100,0,300,0
  48. 260 DATA2,-100,0,100,-100,0,300,0
  49. 270 DATA 5,-150,-10,50,400,-10,50
  50. 280 DATA 400,-10,1000,-150,-10,1000,-150,-10,50,1
  51. 290 DATA5,-250,-10,50,-750,-10,50
  52. 300 DATA -750,-10,1000,-250,-10,1000,-250,-10,50,2
  53. 310 DATA5,-150,-10,-50,400,-10,-50
  54. 320 DATA400,-10,-850,-150,-10,-850,-150,-10,-50,3
  55. 330 DATA5,-250,-10,-50,-750,-10,-50
  56. 340 DATA-750,-10,-850,-250,-10,-850,-250,-10,-50,2
  57. 350 DATA5,-600,400,750,-275,400,750
  58. 360 DATA-275,0,750,-600,0,750,-600,400,750,2
  59. 370 DATA5,-600,400,950,-275,400,950
  60. 380 DATA-275,0,950,-600,0,950,-600,400,950,2
  61. 390 DATA2,-600,400,750,-600,400,950,1
  62. 400 DATA2,-275,400,750,-275,400,950,1
  63. 410 DATA2,-275,0,750,-275,0,950,1
  64. 420 DATA2,-600,0,750,-600,0,950,1
  65. 430 DATA-1
  66. 440 DIMX(5),Y(5),Z(5),C(8),T(16)
  67. 450 IFSE=1ANDS1=2THENS1=0:(null)NEXT0
  68. 451 PRINT"  LOCATION?(X,Y,Z) X=600 Y=600 Z=1000"
  69. 460 INPUTX(3),Y(3),Z(3)
  70. 465 ZZ=Z:Z(3)=-Z(3):XX=X:X(3)=-X(3):YY=Y:Y(3)=-Y(3)
  71. 470 PRINT"  (P)ITCH,(B)ANK,(H)DING P=-35 B=0 H=225"
  72. 480 INPUTP,B,H
  73. 482 PP=P:P=-P:BB=B:B=-B
  74. 485 GOSUB5000
  75. 490 GOSUB740:REM SET UP MATRIX
  76. 500 IFPL=1THEN:PRINT#1,"M",0,0:PRINT#1,"D",479,0
  77. 505 IF PL=1THEN:PRINT#1,"M",0,479:PRINT#1,"D",479,479
  78. 510 RESTORE
  79. 520 READ Q:REM GET NUMBER OF POINTS
  80. 530 IFQ=-1THEN660
  81. 540 READX5,Y5,Z5
  82. 550 X(5)=X5:Y(5)=Y5:Z(5)=Z5
  83. 560 FOR P=2TOQ
  84. 570 X(1)=X5:Y(1)=Y5:Z(1)=Z5
  85. 580 READX5,Y5,Z5
  86. 590 X(5)=X5:Y(5)=Y5:Z(5)=Z5
  87. 600 GOSUB 840:REM TRANSLATE,ROTATE POINTS
  88. 610 GOSUB 920:REM CLIP LINES
  89. 620 GOSUB 1460:REM PROJECT LINES
  90. 630 GOSUB 700
  91. 640 NEXT:READPN%:REM GOSUB2000
  92. 650 GOTO520
  93. 660 IFPL=1THEN:PRINT#1,"M",0,0
  94. 665 GETA$:IFA$=""THEN665
  95. 671 IFA$="2"THENS1=2:GOTO450
  96. 672 IFA$="1"THEN:GOTO3000
  97. 675 GOTO665
  98. 690 IFPL=1THEN:PN%=2:GOSUB2000:PRINT#4:PRINT#4:PRINT#4,"X=";X ;" Y=";Y ;" Z=";Z
  99. 691 IFPL=1THEN:PRINT#4,"PITCH=";PP;" BANK=";BB;" HDNG=";HH
  100. 692 IFSE=1THEN:(null)LET3,4,0,"X="+STR$(XX)+" Y="+STR$(YY)+" Z="+STR$(ZZ),0
  101. 693 IFSE=1THEN:(null)LET2,4,1,"PITCH="+STR$(PP)+" BANK="+STR$(BB)+" HDNG="+STR$(HH),0
  102. 700 IFP2=0THENRETURN
  103. 710 GOSUB 1580
  104. 720 RETURN
  105. 730 REM
  106. 740 DE=(null)/180:CP=COS(P*DE):SP=SIN(P*DE)
  107. 750 CB=COS(B*DE):SB=SIN(B*DE):CH=COS(H*DE):SH=SIN(H*DE)
  108. 760 A1=CH*CB+SH*SP*SB:B1=-CH*SB+SH*SP*CB
  109. 770 C1=SH*CP:D1=CP*SB:E1=CP*CB:F1=-SP:G1=-SH*CB+CH*SP*SB
  110. 780 H1=SH*SB+CH*SP:I1=CH*CP
  111. 790 T(1)=A1:T(2)=B1:T(3)=C1:T(5)=D1:T(6)=E1:T(7)=F1:T(9)=G1:T(10)=H1:T(11)=I1
  112. 800 T(13)=X(3)*A1+Y(3)*D1+Z(3)*G1
  113. 810 T(14)=X(3)*B1+Y(3)*E1+Z(3)*H1
  114. 820 T(15)=X(3)*C1+Y(3)*F1+Z(3)*I1
  115. 830 RETURN
  116. 840 FORA=1TO5STEP4
  117. 850 G=X(A)
  118. 860 H=Y(A)
  119. 870 X(A)=G*T(1)+H*T(5)+Z(A)*T(9)+T(13)
  120. 880 Y(A)=G*T(2)+H*T(6)+Z(A)*T(10)+T(14)
  121. 890 Z(A)=G*T(3)+H*T(7)+Z(A)*T(11)+T(15)
  122. 900 NEXT
  123. 910 RETURN
  124. 920 FOR A=1TO5STEP4
  125. 930 C(A)=0
  126. 940 C(A+1)=0
  127. 950 C(A+2)=0
  128. 960 C(A+3)=0
  129. 970 IFX(A)<-Z(A)THENC(A)=1
  130. 980 IFX(A)>Z(A)THENC(A+1)=1
  131. 990 IFY(A)<-Z(A)THENC(A+2)=1
  132. 1000 IFY(A)>Z(A)THENC(A+3)=1
  133. 1010 NEXT
  134. 1020 FOR A=1TO4
  135. 1030 IFC(A)=0THEN1050
  136. 1040 IFC(A)=C(A+4)THEN1140
  137. 1050 NEXT
  138. 1060 FOR A=1TO4
  139. 1070 IFC(A)=1THEN1160
  140. 1080 NEXT
  141. 1090 FOR A=5TO8
  142. 1100 IFC(A)=1THEN1190
  143. 1110 NEXT
  144. 1120 P2=1
  145. 1130 RETURN
  146. 1140 P2=0
  147. 1150 RETURN
  148. 1160 A=1
  149. 1170 B=5
  150. 1180 GOTO1210
  151. 1190 A=5
  152. 1200 B=1
  153. 1210 IFC(A)=1THEN1310
  154. 1220 IFC(A+1)=1THEN1260
  155. 1230 IFC(A+2)=1THEN1360
  156. 1240 IFC(A+3)=1THEN1410
  157. 1250 GOTO1120
  158. 1260 K=(Z(A)-X(A))/(X(B)-X(A)-Z(B)+Z(A))
  159. 1270 X(A)=K*(Z(B)-Z(A))+Z(A)
  160. 1280 Y(A)=K*(Y(B)-Y(A))+Y(A)
  161. 1290 Z(A)=X(A)
  162. 1300 GOTO920
  163. 1310 K=(Z(A)+X(A))/(X(A)-X(B)-Z(B)+Z(A))
  164. 1320 X(A)=K*(Z(A)-Z(B))-Z(A)
  165. 1330 Y(A)=K*(Y(B)-Y(A))+Y(A)
  166. 1340 Z(A)=-X(A)
  167. 1350 GOTO920
  168. 1360 K=(Z(A)+Y(A))/(Y(A)-Y(B)-Z(B)+Z(A))
  169. 1370 X(A)=K*(X(B)-X(A))+X(A)
  170. 1380 Y(A)=K*(Z(A)-Z(B))-Z(A)
  171. 1390 Z(A)=-Y(A)
  172. 1400 GOTO920
  173. 1410 K=(Z(A)-Y(A))/(Y(B)-Y(A)-Z(B)+Z(A))
  174. 1420 X(A)=K*(X(B)-X(A))+X(A)
  175. 1430 Y(A)=K*(Z(B)-Z(A))+Z(A)
  176. 1440 Z(A)=Y(A)
  177. 1450 GOTO920
  178. 1460 IFP2=0THENRETURN
  179. 1470 IFZ(1)=OTHEN1540
  180. 1480 IFZ(5)=0THEN1540
  181. 1490 X(2)=X(1)/Z(1)*240
  182. 1500 X(4)=X(5)/Z(5)*240
  183. 1510 Y(2)=Y(1)/Z(1)*240
  184. 1520 Y(4)=Y(5)/Z(5)*240
  185. 1530 RETURN
  186. 1540 PRINT"LINE CRASHED AT PYRAMID'S BASE"
  187. 1550 PRINTX(1);Y(1);Z(1);"  ";X(5);Y(5);Z(5)
  188. 1560 P2=0
  189. 1570 RETURN
  190. 1580 X(2)=INT(X(2)+.5)+240
  191. 1590 Y(2)=INT(Y(2)+.5)+240
  192. 1600 X(4)=INT(X(4)+.5)+240
  193. 1610 Y(4)=INT(Y(4)+.5)+240
  194. 1611 X0=INT(INT(X(2)+.5)*.665970772)
  195. 1612 Y0=INT(ABS(199-(INT(Y(2)+.5)*.41544885)))
  196. 1613 X1=INT(INT(X(4)+.5)*.665970772)
  197. 1614 Y1=INT(ABS(199-(INT(Y(4)+.5)*.41544885)))
  198. 1620 IFPL=1THEN:PRINT#1,"M",X(2),Y(2)
  199. 1621 IFPV=0ORSE=0THEN:GOTO1630
  200. 1624 (null)LET3,4,23,"                                        "
  201. 1625 (null)LET3,4,23,"X0="+STR$(X0)+" Y0="+STR$(Y0)+" X1="+STR$(X1)+" Y1="+STR$(Y1),1
  202. 1630 IFPL=1THEN:PRINT#1,"D",X(4),Y(4)
  203. 1635 IFSE=1THEN:(null)GOTO1,X0,Y0 TO X1,Y1
  204. 1640 RETURN
  205. 2000 IFPL=1THEN:PRINT#2,PN%:RETURN
  206. 2001 RETURN
  207. 3000 IFSE=1THEN:(null)LET3,2,24," F1=TEXT SCREEN  F3=GRAPHIC DISPLAY ",1
  208. 3001 IFSE=1THEN:FORX=1TO3000:NEXT:(null)LET3,0,24,"                                      "
  209. 3002 IFPL=1THEN:PRINT#1,"J",0,0:PRINT#4:PRINT#4:CLOSE1:CLOSE2:CLOSE4
  210. 3009 END:STOP
  211. 4000 PRINT"[147]":PRINT"[176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  212. 4001 PRINT"[194]                                     [194]"
  213. 4002 PRINT"[194]    VECTOR GRAPHICS PLOTTER V 1.0  [146]  [194]"
  214. 4003 PRINT"[194]                                     [194]"
  215. 4004 PRINT"[194]     WHEN DISPLAY IS FINISHED        [194]"
  216. 4005 PRINT"[194]     PRESS 1 TO END & 2 TO REPLOT    [194]"
  217. 4011 PRINT"[194]     AFTER PROGRAM ENDS USE:         [194]"
  218. 4012 PRINT"[194]     FNCT KEY 1 = GRAPHIC SCREEN     [194]"
  219. 4013 PRINT"[194]     FNCT KEY 2 = TEXT SCREEN        [194]"
  220. 4014 PRINT"[194]                                     [194]"
  221. 4015 PRINT"[173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]"
  222. 4999 RETURN
  223. 5000 IFSE=1THEN:(null)NEXT2,1
  224. 5001 IFSE=1THEN:(null)FOR0,6,5,2,0
  225. 5999 RETURN
  226.